Collection of Tools & Utilities/Collection of Tools and Utilities.iso/pascal/pasledit.zip/EDITOR.PAS

Pascal/Delphi Source File | 1991-01-17 | 16KB | 459 lines

(*
   Simple line editor program.  Written in Standard Pascal.

   By Ilya Shlyakhter, D-block
*)

PROGRAM LineEditor (Input, Output);

   USES Strings;

   CONST NameCount = 10;
         MaxNameLength = 30;

   TYPE NameArray = ARRAY [1..NameCount] OF StrType;
        NameCountType = 0..NameCount;
        NameLengthType = 0..MaxNameLength;

        Digit = 0..9;

   VAR NameData: NameArray;


   FUNCTION UpCaseChar (Ch: Char): Char;

   (*
       Converts a character to uppercase.
   *)

      BEGIN  (* UpCaseChar *)
         IF Ch IN ['a'..'z'] THEN
            Ch := Chr (Ord (Ch) - Ord ('a') + Ord ('A'));

         UpCaseChar := Ch
      END;   (* UpCaseChar *)

   FUNCTION ChrDigit (Ch: Char): Digit;

      BEGIN   (* ChrDigit *)
         ChrDigit := Ord (Ch) - Ord ('0')
      END;    (* ChrDigit *)

   PROCEDURE FlushLine;

      VAR Ch: Char;

      BEGIN  (* FlushLine *)
         WHILE NOT (Eof OR Eoln) DO
            Read (Ch);

         ReadLn
      END;   (* FlushLine *)


   PROCEDURE ReadNames (VAR Names: NameArray);

      VAR CurrentNameNum: NameCountType;

      PROCEDURE InputName (VAR Name: StrType);

         VAR CurrentCharNum: NameLengthType;
             Ch: Char;

         BEGIN  (* InputName *)
            StrInit (Name);
            CurrentCharNum := 1;

            WHILE NOT Eof AND NOT Eoln AND (CurrentCharNum <= MaxnameLength) DO
               BEGIN  (* read name *)
                  Read (Ch);
                  StrAddChar (Name, Ch);
                  CurrentCharNum := CurrentCharNum + 1
               END;   (* read name *)

            ReadLn
         END;   (* InputName *)

      BEGIN  (* ReadNames *)
         FOR CurrentNameNum := 1 TO NameCount DO
            BEGIN  (* read *)
               WriteLn;
               Write ('Please enter name #',CurrentNameNum,': ');
               InputName (Names [CurrentnameNum])
            END;   (* read *)
      END;   (* ReadNames *)


   PROCEDURE DisplayNames (Names: NameArray);

      VAR I: Integer;

      BEGIN  (* DisplayNames *)
         WriteLn;
         WriteLn ('You have entered the following names:');
         WriteLn;

         FOR I := 1 TO NameCount DO
            BEGIN
               Write (I,' - ');
               StrDisplayString (Names [I])
            END;

         WriteLn;
      END;   (* DisplayNames *)

   PROCEDURE ProcessNames (Names: NameArray);

      VAR NameNum: NameCountType;
          Done: Boolean;


      PROCEDURE EditString (VAR TheString: StrType);

         VAR Done: Boolean;
             Ch: Char;

         PROCEDURE DisplayHelp;

            VAR Ch: Char;

            BEGIN  (* DisplayHelp *)

               FlushLine;
               WriteLn;

               WriteLn ('                EDITOR COMMANDS                                                ');
               WriteLn ('                                                                               ');
               WriteLn (' Icn           Insert character c at position n                              ');
               WriteLn ('                                                                               ');
               WriteLn (' DPn           Delete character at POSITION n                                ');
               WriteLn (' DFc           Delete FIRST occurence of the character c                     ');
               WriteLn ('                                                                               ');
               WriteLn (' RPcn          Replace the character at POSITION n with character c          ');
               WriteLn (' RFcd          Replace the FIRST occurence of character c with character d ');
               WriteLn (' RAcd          Replace ALL  occurences of character c with character d     ');
               WriteLn ('                                                                               ');
               WriteLn (' H, ?          Display this help screeen                                     ');
               WriteLn (' Q             Quit                                                          ');
            END;   (* DisplayHelp *)


         PROCEDURE ReadPos (VAR Value: StrLengthType; VAR Error: Boolean);

            VAR Ch: Char;
                CurrentValue: Integer;
                Digits: SET OF Char;
                Factor: Integer;
                MaxFactor: Integer;

            BEGIN  (* ReadPos *)
               Digits := ['0'..'9'];
               Error := False;

               IF Eof OR Eoln THEN
                  Error := True
                     ELSE
                        BEGIN  (* there is text to read *)
                           CurrentValue := 0;
                           Factor := 1;

                           MaxFactor := 1;
                           WHILE (MaxStrLength DIV MaxFactor) > 0 DO
                              MaxFactor := MaxFactor * 10;


                           WHILE NOT (Eof OR Eoln OR Error OR (Factor > MaxFactor)) DO
                              BEGIN  (* process number *)
                                 Read (Ch);
                                 IF Ch IN Digits THEN
                                    CurrentValue := CurrentValue + ChrDigit (Ch) * Factor
                                       ELSE
                                          Error := True
                              END;   (* process number *)
                        END;   (* there is text to read *)

               IF NOT Error THEN
                  Value := CurrentValue

            END;   (* ReadPos *)

         PROCEDURE ReportError;

            VAR Ch: Char;

            BEGIN  (* ReportError *)

               FlushLine;
               WriteLn;
               WriteLn ('Input error. Try again.');
               WriteLn
            END;   (* ReportError *)

         PROCEDURE ProcessDelete;

            VAR Ch: Char;

            PROCEDURE ProcessDelPos;

               VAR Position: StrLengthType;
                   Error: Boolean;

               BEGIN  (* ProcessDelPos *)
                  ReadPos (Position, Error);

                  IF Error THEN
                     ReportError
                        ELSE
                           BEGIN
                              StrDeleteCharPos (TheString, Position);
                              FlushLine
                           END
               END;   (* ProcessDelPos *)

            PROCEDURE ProcessDelFirst;

               VAR Position: StrLengthType;
                   Ch: Char;

               BEGIN  (* ProcessDelFirst *)
                 IF NOT (Eof OR Eoln) THEN
                   BEGIN  (* process parameter *)
                     Read (Ch);
                     StrDeleteCharFirst (TheString, Ch);
                     FlushLine
                   END    (* process parameter *)
                     ELSE
                        ReportError;

               END;   (* ProcessDelFirst *)

            BEGIN  (* ProcessDelete *)
               IF Eof OR Eoln THEN
                  ReportError
                     ELSE
                        BEGIN
                           Read (Ch);  (* read Delete subfunction *)

                           CASE UpCaseChar (Ch) OF
                              'P': ProcessDelPos;
                              'F': ProcessDelFirst;

                              ELSE
                                 ReportError
                           END  (* case *)
                        END;

            END;   (* ProcessDelete *)

         PROCEDURE ProcessInsert;

            VAR Position: StrLengthType;
                VAR Ch: Char;
                Error: Boolean;

            BEGIN  (* ProcessInsert *)
              IF Eof OR Eoln THEN
                ReportError
                  ELSE
                     BEGIN  (* at least 1 parameter given *)
                        Read (Ch);
                        IF Eof OR Eoln THEN